perm filename MJUST.FAI[XX,LCS] blob sn#215096 filedate 1976-05-11 generic text, type T, neo UTF8
00100	C******  MOVER, MVBEAM, MVBX, RTLINE, EXTEN, CLEFS
00200		SUBROUTINE MOVER
00300		IMPLICIT INTEGER(A-Q,S-Z)
00400		DIMENSION R(2,200),IR(2,200),NP(500)
00500		REAL POS,EXTEN,PRCNT,ACCX
00600		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK/STF/RSTFAC(-3/4),RSTJ2
00700		COMMON/XRN/RN(4000)  /KJY/ KY,JY
00800		COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
00900		COMMON/POSI/STFF(-3/4),JJ2,POS/PTR/PWDS(250),ITEM,LL,I,IX
01000		COMMON/ALF/INP(46),ACCX,ML,RRT,RZRO,RCNT,RJSZ,ROV,RSPC,KN,RA,RB,
01100		1 JLDGR,LDGR,JX,RW,RX,RY,RZ,JJ,RD,RQ,RE,RZZ,RN3,RN6,RV,RQ6
01200	      EQUIVALENCE (R5,RJQ(3)),(R6,RJQ(4)),(R7,RJQ(5)),(R4,RJQ(2))
01300		1,(R3,RJQ(1)),(R8,RJQ(6)),(R9,RJQ(7)),(R11,RJQ(9))
01400		1,(IR,R,RN(3501)),(NP,RN(3000))
01500		DATA F78F/'(78F)'/,FA1/'(A1 )'/,FA5/'(A5 )'/,RSP/.5/,RI/4.5/
01600	
01700		JJ2=999
01800		J2=0
01900		ASK=-1
02000	C  99=BACKUP
02100	6	CALL VLINE(R2,R4,R5,R6)
02200		IF(R2.GE.99)RETURN
02300		IF(INP(1).EQ.'J')GO TO 12
02400		TYPE 5
02500		ACCEPT F78F,R7,R8,R9,R11
02600		RDIS=0
02700		REREAD FA1,L
02800	C FOR LPEN TYPE 'L'. BUT 4TH # MUST APPEAR WHEN NEEDED.
02900		IF(L.EQ.'B')GO TO 6
03000		IF(R7.GE.99)GO TO 6
03100		IF(R2.GT.4)R7=R2
03200		IF(R7.NE.R2)TYPE 1200,R7
03300	1201	IF(L.NE.'L')GO TO 66
03400		DO 67 K=1,2
03500		R8=RY
03600		CALL LPEN(R7,RY,RX)
03700	67	IF(R7.GE.99)GO TO 6
03800		R9=RY
03900	CC66	JJ2=1
04000	66	NST=1
04100	C  FOR START OF LOOP (1 UNLESS USING COPYIT)
04200		IF(INP(1).NE.'C')GO TO 68
04300		NST=ITEM+1
04400		CALL COPYIT
04500	68	IF(R11.NE.0)CALL UPDN(NST)
04600		JJ=0 
04700		IF(R4.NE.R8.OR.R5.NE.R9)JJ=-1
04800		JY=0
04900	C  JY IS CHANGED IN GETPTS
05000		IF(JJ)CALL GETPTS(NST)
05010		IF(R2.NE.R7)CALL STFCH
05050		IF(JY.NE.0)GO TO 1
05060	7	IF(JJ2.EQ.999)JJ2=-1
05070		RETURN
05200	CC	IF(JY.EQ.0)RETURN
05300	1	CALL MOVIT
05400		RETURN
05410	MJUST:	0
05500		SKIPE 3,R4	;12	IF(R4.EQ.0)R4=.001
05510		JRST .+3
05550		MOVE 3,[0.001]
05575		MOVEM 3,R4
05600		SKIPE 2,R5	;  IF(R5.EQ.0)R5=200
05620		JRST .+3
05640		MOVE 2,[200.0]
05660		MOVEM 2,R5
05700		SETZM RCNT#	;  RCNT=0
05800		MOVEM 2,RRT#	;	RRT=R5
05900		MOVEM 3,RZRO#	;	RZRO=R4
06000		MOVE [4.5]	;	RJSZ=RI
06020		MOVEM RJSZ#
06100		JSA 16,GETPTS	;	CALL GETPTS(1)
06120		JUMP [1]
06200		SKIPN KJY+1	;	IF(JY.EQ.0)GO TO 7
06220		JRST MV7	;RETURN IF NO ITEMS FOUND TO DEAL WITH.
06300		MOVE RRT	;	ROV=RRT
06320		MOVEM ROV#
06400		MOVE [1.0]	;	PRCNT=1.
06420		MOVEM PRCNT#
06500		MOVE .COMM.	;	R7=R2
06520		MOVEM .COMM.+=8
06600		SETZM .COMM.+7	;	R6=0
06700		SETZM .COMM.=12	;	R11=0
06800	MV19:	MOVE RCNT	;19	IF(RCNT.GT.9)GO TO 101
06820		CAILE =9	; MAKE RCNT AN INTEGER!
06840		JRST MV101
06900		MOVN [0.06]	;	RJSZ=RJSZ-.06
06920		FADRM RJSZ
07000		MOVE PRCNT	;	RP=PRCNT
07020		MOVEM RP#
07100		AOS RCNT	;	RCNT=RCNT+1
07200	;  TEMPORARY COUNTER
07300		JSA 16,JTYPE	;	TYPE F78F,RCNT
07320		JUMP RCNT
07400	
07500		MOVNI 15,3	DO 11 KN=-3,4	
07600	MVX11:	SETZM RSPC#	;	RSPC=0
07700		MOVE 14,15	;	R8=KN
07720		TLC 14,232000
07740		FADR 14,14	;14 IS R8 FOR NOW
07800		SETO 12,	; N=0  12 IS N  -- START WITH -1
07900	
08000		MOVEI 13,1	; DO 2 K=1,KY
08100	MVX2:	MOVE 11,XRN+=2999(13)	; 11 IS L   L=NP(K)
08200		MOVE 10,XRN-1(11)	; 10 IS RL  RL=RN(L)
08300		MOVE 7,XRN(11)		; 7 IS RA   RA=RN(L+1)
08400		MOVE 6,XRN+2(11)	; 6 IS RB  RB=RN(L+3)
08500		CAMN 14,XRN+1(11)	;IF(RN(L+2).EQ.R8)GO TO 77
08520		JRST MV77  	;THIS STAFF?
08700		CAME 7,[4.0]	;	IF(RA.NE.4)GO TO 2
08720		JRST MV2  	; SKIPS HOMED NOTES (IN CHORDS)
09100	MV77:	CAMGE 7,[3.0]	;77	IF(RA.LT.3)GO TO 10
09120		JRST MV10
09200		CAMN 7,[4.0]	;	IF(RA.EQ.4)GO TO 444
09220		JRST MV444
09300		CAMN 7,[3.0]	;	IF(RA.EQ.3)GO TO 333
09320		JRST MV333    ; LOOKS AT NOTES,RESTS,CLEFS,BAR LINES,KSIGS,METERS.
09500		CAMGE 7,[17.0]	;	IF(RA.LT.17)GO TO 2
09520		JRST MV2
09600		JRST MV10	;	GO TO 10
09700	MV333:	CAMGE 10,[3.0]	;333	IF(RL.LT.3)GO TO 10
09720		JRST MV10    ;  <3 MEANS NOTHING IN P5
09900		JSA 16,AMOD    	;	IF(AMOD(RN(L+5),100.0).GT.3)GO TO 2
09920		JUMP XRN+4(11)
09940		JUMP [100.0]
09960		CAMLE [3.0]
09980		JRST MV2   ;  NOT A REAL CLEF IF >3
10100		JRST MV10		;  GO TO 10
10200	MV444:	CAMLE 10,[2.0]		;444	IF(RL.GT.2)GO TO 2
10220		JRST MV2    ;  SHOULD CHECK ON BAR LINES NO MATTER WHICH STAFF
10400	MV10:	AOJ 12		;10	N=N+1
10500		MOVE 1,12	;	R(1,N)=RB
10520		IMULI 1,2
10540		MOVEM 6,XRN+=3500(1)
10600		MOVEM 11,XRN+=3501(1)	;   IR(2,N)=L
10700		CAIN 12,=198	;	IF(N.EQ.200)GO TO 28
10720		JRST MV28   ;  ONLY TREATS 200 ITEMS AT A TIME.
10900	MV2:	CAMGE 13,KJY		;2	CONTINUE
10920		AOJA 13,MVX2
11000	
11100		JUMPL 12,MV11	;	IF(N.EQ.0)GO TO 11
11200	MV28:	SETZ 13, 	;	28	DO 23 K=1,N
11202	MV23:	MOVE  1,13
11260		IMULI 1,2 
11280		CAME 2,XRN+=3501(1)
11282		JRST MV24
11300		CAME 13,12	;23	IF(RN(IR(2,K)+1).NE.4)GO TO 24
11302		AOJA 13,MV23   ;  SKIPS IF ONLY BAR LINES ON THIS STAFF
11500		JRST MV11	;	GO TO 11
11600	MV24:	MOVE 2,STF+3(15)	;24	RSTJ2=RSTFAC(KN)*PRCNT
11620		FMPR 2,PRCNT
11640		MOVEM 2,STF+=8
11660		MOVE 5,12
11680		AOJ 5,
11700		JSA 16,SORT2	;	CALL SORT2(R,N)
11710		JUMP XRN+=3500
11720		JUMP 5		; (N)
11800	
11900	;  JUMP IF LAST IS A BAR LINE.
12000		SETO 13,	;	K=0   (-1 NOW)
12100		SETZM JLDGR#	;	JLDGR=0
12200	     	SETZM JX#	;	JX=0
12300	MV22:	AOJ 13,		;22	K=K+1
12400	MV122:	MOVE 1,13	;122	L=IR(2,K)
12420		IMULI 1,2
12440		MOVEM 11,XRN+=3501(1)
12500		MOVE 7,XRN(11)		;  RA=RN(L+1)
12550	;  7=RA IS NOW CODE NUM.
12600		SETZ 6,		;	RB=0
12610		SETZM RD#	;	RD=0
12655	;  RD WILL HOLD SPACE TO ADD TO PREV. ITEM, IF NEEDED.
12700		MOVE XRN+4(11)	;	RX=RN(L+5)
12720		MOVEM RX#	; RX=PARAM 5
12900		MOVE XRN+6(11)	;	RX6=RN(L+6)
12920		MOVEM RX6#
13000		MOVE [1.0]	;	RY=1
13020		MOVEM RY#
13100		JSA 16,AMOD	;	RW=AMOD(RN(L+4),100.)
13120		JUMP XRN+3(11)
13140		JUMP [100.0]
13160		MOVEM RW#
13200		CAMLE 7,[1.0]		;	IF(RA.GT.1)GO TO 4
13220		JRST MV4
13300		MOVE XRN+6(11)		;	RZ=RN(L+7)
13320		MOVEM RZ#
13400		MOVE JLDGR	;	IF(LDGR.NE.JLDGR)JLDGR=0
13420		CAME LDGR#
13440		SETZM JLDGR
13500		SETZM LDGR#	;	LDGR=0
13600		AOJ  13		;	JK=K
13640		MOVEM 13,JK#
13700	MVX32:	MOVE 14,13	;	DO 32 JJ=JK+1,N+1
13750		AOJ 13		;	K=JJ
13810		MOVE 1,14	;	RB=R(1,JJ)-R(1,JJ-1)
13815		IMULI 1,2
13817		MOVE 2,XRN+=3500(1)
13818		FSBR 2,XRN+=3498(1)	; 2=RB NOW
13820		CAMLE 2,[0.1]		; IF(RB.GT.0.1)GO TO 320
13822		JRST MV320	;  PUTS THEM AT EXACT SAME POINT IF CLOSER THAN .1
13830		MOVE 3,XRN+=3498(1)	;  R(1,JJ)=R(1,JJ-1)
13835		MOVEM 3,XRN+=3500(1)
13840		JRST MV32		;   GO TO 32
13900	MV320:	CAMLE 2,[0.5]		; 320	IF(RB.GT.RSP)GO TO 35
13905		JRST MV35
13910	MV32:	AOJ 14,			;32	CONTINUE
13955		MOVE 1,14
13977		AOJ 1,
13988		CAMGE 1,12		; 12=N
13994		JRST MVX32		;FOUND HOW MANY MEMBERS TO CHORD.
14100	MV35:	SETZ 6,			;35	RB=0  (6)
14200		SOJ 13,			;K=K-1
14300		SETZ 10,		;  RQ=0   (10)
14510	MV125:	MOVM 5,XRN+3(11)	;5=RC  125	RC=ABS(RN(L+4))
14515		
14520		CAMGE 5,[60.0]		;  IF(RC.LT.60)GO TO 137
14525		JRST MV137
14530		CAML 5,[180.0]		;  IF(RC.LT.180)RY=.6
14535		JRST .+3
14537		MOVE [0.6]
14538		MOVEM RY		;FOUND A MINI-NOTE
14600	MV137:	MOVE 12,JK		;137	DO 37 JJ=JK,K-1
14700	MVX37:	JUMPN 6,MV38		;  IF(RD.NE.0)GO TO 38
14800	; FINDS ONLY HIGH OR! LOW LED. LINE.
14900		MOVE 1,12	;  JR=IR(2,JJ)
14910		SOJ 10,
14920		ADD 10,10
14930		MOVE 10,XRN+=3501(10)
15000		JSA 16,AMOD	;  RW=AMOD(RN(JR+4),100.)
15010		JUMP XRN+3(10)
15020		JUMP [100.0]
15100		MOVE RW		;  IF(RW.GT.12)GO TO 277
15110		CAMLE [12.0]
15120	
15130		JRST MV277
15200		CAML [2.0]	;   IF(RW.GE.2)GO TO 38
15210		JRST MV38
15300	MV277:	SETOM LDGR	;   277	LDGR=-1
15400		CAMG [11.0]	;   IF(RW.GT.11)LDGR=1
15410		JRST .+3
15420		MOVEI 1
15430		MOVEM LDGR
15500		MOVE LDGR	;   IF(JLDGR.EQ.LDGR)GO TO 36
15510		CAMN JLDGR
15520		JRST MV36
15600		MOVEM JLDGR	;   JLDGR=LDGR		 LDGR IS FOR LEDGER LINES.
15800		JRST MV38	;	GO TO 38
15900	MV36:	MOVE 4,[1.5]	;  36	RD=1.5
15910		MOVEM 4,RD
16000		MOVEM 4,RQ#	;   RQ=RD
16100	MV38:	CAMLE 6,[2.0]		;  38	IF(RB.GT.2)GO TO 222
16110		JRST MV222	  ; JUMP IF LARGE SPACE AFTER NOTE IS ALREADY SET UP.
16300		MOVE 1,XRN+6(10)	; 10=JR    RZZ=RN(JR+7)
16310		MOVEM 1,RZZ#
16400		MOVE 2,XRN+4(10)	;  RE=RN(JR+5)
16410		MOVEM 2,RE#
16700		CAML 6,[2.0]		;  IF(RB.GE.2)GO TO 477
16710		JRST MV477
16800		CAML 1,[10.0]		;  IF(RZZ.GE.10)GO TO 377
16810		JRST MV377
16900		CAML 2,[20.0]		;   IF(RE.GE.20)GO TO 477
16910		JRST MV477
17000		JSA 16,AMOD		;  IF(AMOD(RZZ,10.).EQ.0)GO TO 477
17010		JUMP RZZ
17020		JUMP [10.0]
17030		JUMPE MV477
17100	MV377:	JSA 16,EXTEN		;  377	RB=1.5+EXTEN(RZZ)
17150		JUMP RZZ
17160		FADR [1.5]
17170		MOVE 6,			; 6=RB
17200	;  SPACE FOR DOT OR TAIL(IF STEM UP)
17300	MV47:	MOVM XRN+5(10)		;477	IF(ABS(RN(JR+6)).EQ.10)RB=RB+2
17310		CAMN [10.0]
17330		FADR 6,[2.0]		;FOR CHORD TONES ON RIGHT OF STEM UP.
17500	;  LOOKS THROUGH ALL NOTES OF A CHORD.
17600	MV222:	JSA 16,AMOD		;  222	IF(AMOD(RE,10.).EQ.0)GO TO 37 
17610		JUMP RE
17620		JUMP [10.0]
17630		JUMPE MV37		;JUMP IF NO ACCIS.
17800	MV425:	JSA 16,EXTEN		;  425	RD=2*RY+EXTEN(RE)
17810		JUMP RE
17820		FADR RY
17830		FMPR [2.0]
17900		CAMG RQ			;  IF(RQ.GT.RD)RD=RQ
17910		MOVE RQ
17920		MOVEM RD#
18000		MOVEM RQ		;  RQ=RD
18100	;  FUNCT. EXTEN=AMOD(X,1.)*10.
18200	MV37:	AOJ 12,       		;37	CONTINUE
18210		CAMGE 12,13
18220		JRST MVX37
18300		MOVE RY			;  IF(RY.NE.1)RB=RB-.5*RJSZ
18310		CAMN [1.0]
18320		JRST MV250
18330		MOVN 1,RJSZ
18340		FMPR 1,[0.5]
18350		FADR 6,1		;MINI NOTES NEED LESS SPACE
18500	MV250:	SETZM ACCX#		;  250	ACCX=0
18600		SETZM RC#		;  RC=0
18700		MOVE 1,JX		;  RW=R(1,JX+1)
18710		ADD 1,1
18720		MOVE 7,XRN+=3500(1) 	; 7=RW
18800		MOVE 10,JX		;  DO 132 JJ=JX+1,N  
18900	MVX132:	MOVE 1,10		;	IF(RW.NE.R(1,JJ))GO TO 25
18910		ADD 1,1
18920		CAME 7,XRN+=3500(1)
18930		JRST MV25
19000		MOVE 6,XRN+=3501(1)	;  KX=IR(2,JJ)
19100	;  GET POINTER
19200		MOVE 2,XRN(6)		; IF(RN(KX+1).NE.1)GO TO 25
19210		CAME 2,[1.0]
19220		JRST MV25	;ONLY CHECK ON NOTES (THIS IS FOR CHRD NOTES WITH ACCIS)
19310		MOVM 4,XRN+5(2)		;  RE=ABS(RN(KX+6))
19330		CAMGE 4,[10.0]		;  IF(RE.GE.10)RC=-2.6
19335		JRST .+3
19337		MOVN [2.6]
19338		MOVEM RC
19340		CAMN 4,[20.0]		; IF(RE.EQ.20)RC=-RC
19345		MOVNS RC
19400	***********************	RE=AMOD(RN(KX+5),10.0)
19500	C  FIND AN ACCI
19600		IF(RE.EQ.0)GO TO 132
19700		IF(RE.GE.1)RC=RC+2
19800	C  FOUND AN ACCI
19900	CC	***** WHY WAS THIS *10?????    RC=AMOD(RE,1.0)*10.0+RC
19910		RC=AMOD(RE,1.0)*10.0+RC
20000	C  ADD ANY EXTENSION TO THE LEFT
20100		IF(RC.GT.ACCX)ACCX=RC
20200		RC=0
20250		IF(ACCX.GT.RD)RD=ACCX
20300	132	CONTINUE
20400	25	IF(JX.GT.0)R(2,JX)=R(2,JX)+RD*RSTJ2
20500		GO TO 17
20510	4	IF(RA.NE.2)GO TO 33
20530	C  NEXT FOR DOTTED RESTS - IN P6
20540		IF(RN(L).GE.4)RB=RN(L+6)*1.5
20545	C  NOW GO BACK TO SEE IF THERE IS A NOTE IN SAME HORIZ. POS.
20550		GO TO 250
20600	33	IF(RA.NE.3)GO TO 29
20700		RB=3
20800		IF(RX.GT.100)RB=1.5
20900	C  CHECK ON SIZE NEEDED FOR CLEFS
21000	29	IF(RA.NE.4)GO TO 26
21100		RB=-RJSZ/2
21200		RD=.9
21300		GO TO 25
21400	26	IF(RA.NE.18)GO TO 30
21500		IF(RX6.GT.9)GO TO 31
21600		IF(RX.GT.9)GO TO 31
21700	C  CHECKS FOR 2-DIGIT METERS
21800		RB=-1
21900		RD=1
22000		GO TO 25
22100	31	RB=2
22200		RD=3
22300		GO TO 25
22400	30	IF(RA.NE.17)GO TO 17
22500		RB=2*(ABS(RX)-1)-2
22600	C  SPACES FOR CORRECT NUM OF ACCIS.  RX=NUM OF ACCIS.
22700		RD=2
22800		GO TO 25
22820	C  ↑↑↑↑↑ TO RESET AFTER CHORD NOTES 12/75
22900	17	RC=(RB+RJSZ)*RSTJ2
23000	C  RJSZ=DEFAULT SIZE
23100		JX=K
23200		R(2,JX)=RC
23300	CC???????	R(1,JX)=R(1,K)
23400	3	IF(K.LT.N)GO TO 22
23500		RA=R(1,1)
23600		RB=R(2,1)
23700	
23800		DO 13 KX=2,JX
23900		RE=R(1,KX)
24000	C  POS. BEFORE SHIFTING
24100		IF(ABS(RE-RA).GT..5)GO TO 14
24200		IF(R(2,KX).GT.RB)GO TO 16
24300	C  SKIPS DOUBLE STOPS AND VERY CLOSE ITEMS
24400		GO TO 13
24500	C  JUMP WHEN SPACE TO ADD IS SMALLER THAN WHAT'S ALREADY THERE
24600	14	RD=RA+RB-RE
24700		IF(RD.LE.0)GO TO 16
24800	C  THERE'S ENOUGH ROOM
24900		ROV=ROV+RD
25000	140	R4=RE+RSPC-.001
25100		R5=10000
25200		R8=RD
25300		R9=0
25400	C  GO EXPAND IT
25500		IF(R(2,KX).EQ.0)GO TO 15
25600		CALL MOVIT
25700		IF(R2.LE.4)GO TO 15
25800		R5=R4
25900		R4=RA+.001+RSPC
26000		R8=R4
26100		R9=R5+RD-.001
26200	C  FOR ITEMS ON OTHER LINES.
26300		CALL MOVIT
26400	15	RSPC=RSPC+RD
26500	C  RSPC SAVES TOTAL SPACE ADDED
26600	16	RB=R(2,KX)
26700	13	RA=RE
26800	11	CONTINUE
26900	110	IF(ROV.LE.RRT+.01)RETURN
27000		IF(RJSZ.GT.4)RJSZ=4
27100		PRCNT=(ROV-RZRO)/(RRT-RZRO)
27200		IF(PRCNT.NE.RP)GO TO 19
27300	C  GO BACK AND EXPAND SOME MORE
27400	101	R4=RZRO
27500		R5=ROV
27600		R8=RZRO
27700		R9=RRT-.001
27800	C  JUSTIFYING SPACE DIMINISHES EACH TIME AROUND.
27900		CALL MOVIT
28000	C  RVX SHOULD BE FARTHEST POINT TO RIGHT.
28100	1200	FORMAT(' MOVED TO STAFF ',F4.0/)
28200		CALL HYDPOG(3)
28300	5	FORMAT(' TYPE NEW STAFF #, POS1, POS2, UP-DOWN #  '$)
28400		END